home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
vol6n20.arc
/
PROFIL.ARC
/
DRAWHIST.PRF
< prev
next >
Wrap
Text File
|
1987-10-31
|
11KB
|
319 lines
{ These procedures handle the bookwork to display histograms of the program's }
{ execution profile. The histograms can be displayed on the screen or on the }
{ printer. }
const
FirstPrintLine = 6;
LastPrintLine = 60;
LastScreenLine = 25;
Printing : boolean = false ;
var
LineNum : integer ;
{ This procedure begins a new page. If the output is going to the printer }
{ ( Printing = true ), it issues a formfeed, then skips lines to }
{ FirstPrintLine. If output is going to the screen, it clears the screen. }
{ In either case, it keeps track of the current output line number. }
procedure PrintNewPage ;
begin
if Printing then
begin
Write(LST, ^L) ;
LineNum := 1;
while LineNum < FirstPrintLine do
begin
WriteLn( LST );
LineNum := succ(LineNum);
end;
end
else
begin
ClearScreen ;
LineNum := 1 ;
end;
end; { procedure PrintNewPage }
{ Test for whether output will be going to last line of screen or page }
function EndPage : boolean ;
begin
if Printing then
EndPage := (LineNum = LastPrintLine)
else
EndPage := (LineNum = LastScreenLine) ;
end; { function EndPage }
{ Print text line, either to the printer or to the screen }
procedure Print( Text : string80 ) ;
begin
if Printing then
WriteLn(LST, Text)
else
FastWrite( Text, LineNum, 1, TextAttr ) ;
LineNum := succ(LineNum) ;
end; { procedure Print( Text : string80 ) }
{ Bins is the number of bins being combined into one output line. First is }
{ the index of the first bin going into the current output line. This }
{ function returns the total number of hits in the bins from First to }
{ First + Bins, which tells the program how many hits to show on the current }
{ output line. }
function RowLength( First, Hi, Bins : integer ) : integer ;
var
I, Count, Limit : integer ;
begin
Count := 0 ;
Limit := pred( Bins ) ;
{ next line makes sure we're not counting data outside the array }
if (succ(Hi-First)) < Limit then Limit := succ(Hi-First) ;
for I := 0 to Limit do
Count := Count + Bin^[First+I] ;
RowLength := Count ;
end; { function RowLength( First, Hi, Bins : integer ) }
{ Find the largest number of hits for any one output line }
function MaxLength( Low, Hi, Bins : integer ) : integer ;
var
TempLength, MaxSoFar, First : integer ;
begin
MaxSoFar := 0 ;
First := Low ;
while First <= Hi do
begin
TempLength := RowLength( First, Hi, Bins ) ;
if TempLength > MaxSoFar then MaxSoFar := TempLength ;
First := First + Bins ;
end;
MaxLength := MaxSoFar ;
end; { function MaxLength( Low, Hi, Bins : integer ) }
{ Convert an integer to a hex string }
function HexStr( Num : integer ) : string4 ;
const
HexChar : array[0..15] of char = '0123456789ABCDEF' ;
var
LoByte,
HiByte : integer ;
begin
LoByte := Lo( Num ) ;
HiByte := Hi( Num ) ;
HexStr := HexChar[ HiByte shr 4 ] +
HexChar[ HiByte and $0F ] +
HexChar[ LoByte shr 4 ] +
HexChar[ LoByte and $0F ] ;
end; { function HexStr( Num : integer ) }
procedure DrawHist( Low, Hi, Bins : integer ) ;
const
DotLine : string80 = '********************************************************************************' ;
var
SegStr : string4 ;
Factor : real ;
First : integer ;
ch : char ;
begin
SegStr := HexStr( CountSeg ) ;
Factor := 70./MaxLength( Low, Hi, Bins ) ; { 70 characters per line }
First := Low ;
while First <= Hi do
begin
PrintNewPage ;
Print( ' Execution Profile' ) ;
Print( '' ) ;
while ((not EndPage) and (First <= Hi)) do
begin
{ Set line length to 70*Hits/MaxHits }
DotLine[0] := chr(trunc(RowLength( First, Hi, Bins )*Factor + 0.5 )) ;
{ Print the current line }
Print( SegStr + ':' + HexStr( CountOfs + BinSize*(First) ) + ' ' + DotLine ) ;
First := First + Bins ;
end; {while}
{ get here when screen or page is full, or when the display is done }
if not Printing then
begin
if First <= Hi then
First := First - Bins ;
FastWrite( 'Press any key to continue...', 25, 1, EmphAttr ) ;
Read(KBD, ch ) ;
end; {if}
end; {while}
if Printing then WriteLn( LST, ^L );
end; { procedure DrawHist( Low, Hi, Bins : integer ) }
{ Search the array Bin^ for the first and last non-zero entries. Don't need }
{ to display anything outside this range. }
procedure FindLimits( var LowerLimit, UpperLimit : integer ) ;
begin
LowerLimit := 0 ;
while ( (LowerLimit < 4095) and (Bin^[LowerLimit] = 0) ) do
LowerLimit := succ( LowerLimit ) ;
UpperLimit := 4095 ;
while ( (UpperLimit >= LowerLimit) and (Bin^[UpperLimit] = 0) ) do
UpperLimit := pred( UpperLimit ) ;
end; { procedure FindLimits( var LowerLimit, UpperLimit : integer ) }
{ Get number of bins to combine on each line. If nothing is specified by the }
{ user, the program determines the proper number to produce exactly one page }
{ of output. }
procedure GetRowSize( NumBins : integer ; var BinsPerRow : integer ) ;
begin
BinsPerRow := 0 ;
FastWrite( 'Number of bins to combine:', 8, 14, TextAttr ) ;
GotoXY( 41, 8 ) ;
ReadLn( BinsPerRow ) ;
HideCursor ;
if BinsPerRow > NumBins then BinsPerRow := succ(NumBins) ;
if BinsPerRow <= 0 then
case Printing of
false : BinsPerRow := NumBins div (LastScreenLine - 3) + 1;
true : BinsPerRow := NumBins div (LastPrintLine - FirstPrintLine - 2) + 1;
end; {case}
end; { procedure GetRowSize( NumBins : integer ; var BinsPerRow : integer ) }
{ Convert hex input to integer }
procedure Convert( Text : string4 ; var Value : integer ; var OK : boolean ) ;
begin
Value := 0 ;
OK := true ;
while Text <> '' do
begin
Text[1] := Upcase( Text[1] ) ;
case Text[1] of
' ' : ;
'0'..'9' : Value := Value*16 + ord(Text[1]) - ord('0') ;
'A'..'F' : Value := Value*16 + ord(Text[1]) - ord('A') + 10 ;
else OK := false ;
end; {case}
delete( Text, 1, 1 ) ;
end; {while}
end; { procedure Convert( Text : string4 ; var Value : integer ; var OK : boolean ) }
{ Called when user wants to display a different range of addresses. Prompts }
{ for new range and inputs it, making sure bounds are between LowerLimit and }
{ UpperLimit. }
procedure GetRange( LowerLimit, UpperLimit : integer ;
var Lower, Upper : integer ) ;
var
TempStr : string4 ;
OK : boolean ;
begin
FastWrite( 'New Range:', 8, 14, EmphAttr ) ;
FastWrite( HexStr(CountSeg) + ':', 8, 30, EmphAttr ) ;
repeat
FastWrite( ' ', 8, 35, TextAttr ) ;
GotoXY( 35, 8 ) ;
ReadLn( TempStr ) ;
Convert( TempStr, Lower, OK ) ;
until OK ;
Lower := (Lower-CountOfs) div BinSize ;
if ((Lower + $8000) < (LowerLimit + $8000)) then Lower := LowerLimit ;
if ((Lower + $8000) > (UpperLimit + $8000)) then Lower := UpperLimit ;
FastWrite( HexStr(CountSeg) + ':', 8, 41, EmphAttr ) ;
repeat
FastWrite( ' ', 8, 46, TextAttr ) ;
GotoXY( 46, 8 ) ;
ReadLn( TempStr ) ;
Convert( TempStr, Upper, OK ) ;
until OK ;
HideCursor ;
Upper := (Upper-CountOfs) div BinSize ;
if ((Upper + $8000) > (UpperLimit + $8000)) then Upper := UpperLimit ;
if ((Upper + $8000) < (Lower + $8000)) then Upper := Lower ;
FastWrite( BlankLine, 8, 1, TextAttr ) ;
end; { procedure GetRange }
{ Convert unsigned decimal integer to text string }
function CardStr( Num : integer ) : string5 ;
var
TempStr : string[6] ;
TempNum : real ;
begin
TempNum := 1.* Num ;
if TempNum < 0. then TempNum := TempNum + 65536. ;
str( TempNum:5:0, TempStr ) ;
CardStr := TempStr ;
end; { function CardStr( Num : integer ) }
{ Count total hits }
function HitCount( Lower, Upper : integer ) : integer ;
var
I,
HitsSoFar : integer ;
begin
HitsSoFar := 0 ;
for I := Lower to Upper do
HitsSoFar := HitsSoFar + Bin^[I] ;
HitCount := HitsSoFar ;
end; { function HitCount( Lower, Upper :integer ) }
{ Display memory range on specified Line }
procedure DisplayLimits( Lower, Upper : integer ; Line : byte ; Text : string80 ) ;
begin
FastWrite( BlankLine, Line, 1, TextAttr ) ;
FastWrite( Text, Line, 14, TextAttr ) ;
FastWrite( HexStr(CountSeg)+':'+HexStr(CountOfs+BinSize*Lower), Line, 30, TextAttr ) ;
FastWrite( HexStr(CountSeg)+':'+HexStr(CountOfs+BinSize*succ(Upper)-1), Line, 41, TextAttr ) ;
FastWrite( CardStr(succ(Upper-Lower)), Line, 53, TextAttr ) ;
FastWrite( CardStr(HitCount(Lower,Upper)), Line, 61, TextAttr ) ;
end; { procedure DisplayLimits( Lower, Upper : integer ; Line : byte ; Text : string80 ) }
procedure ShowProfile ;
var
LowerLimit, UpperLimit,
DispLower, DispUpper,
BinsPerRow : integer ;
done : boolean ;
ch : char ;
{ Show a histogram on the screen or on the printer }
procedure ShowHist( prtg : boolean ) ;
begin
Printing := prtg;
GetRowSize( DispUpper-DispLower, BinsPerRow ) ;
DrawHist( DispLower, DispUpper, BinsPerRow ) ;
DrawProfileScreen;
end; { procedure ShowHist( prtg : boolean ) }
{ Display data and menu }
begin
DrawProfileScreen ;
FindLimits( LowerLimit, UpperLimit ) ;
DispLower := LowerLimit ;
DispUpper := UpperLimit ;
done := false ;
repeat
FastWrite( 'Low High Bins Hits', 5, 33, EmphAttr ) ;
DisplayLimits( LowerLimit, UpperLimit, 6, 'Full Range:' ) ;
DisplayLimits( DispLower, DispUpper, 7, 'Display Range:' ) ;
FastWrite( '0 to exit', 10, 30, TextAttr ) ;
FastWrite( '1 to change display range', 11, 30, TextAttr ) ;
FastWrite( '2 to display histogram', 12, 30, TextAttr ) ;
FastWrite( '3 to print histogram', 13, 30, TextAttr ) ;
FastWrite( 'Indicate selection:', 15, 30, EmphAttr ) ;
GotoXY( 50, 15 ) ;
repeat
Read(KBD, ch) ;
until ch in [ '0', '1', '2', '3' ] ;
{ Erase the menu }
FastWrite( BlankLine, 10, 1, TextAttr ) ;
FastWrite( BlankLine, 11, 1, TextAttr ) ;
FastWrite( BlankLine, 12, 1, TextAttr ) ;
FastWrite( BlankLine, 13, 1, TextAttr ) ;
FastWrite( BlankLine, 15, 1, TextAttr ) ;
case ch of
'0' : done := true ;
'1' : GetRange( LowerLimit, UpperLimit, DispLower, DispUpper ) ;
'2' : ShowHist( false ) ;
'3' : ShowHist( true ) ;
end; {case}
until done ;
end; { procedure ShowProfile }